Aminet 2/Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso/Aminet/dev/misc/toolbox.lha/Toolbox/lib/lalr/Parser.mod

Text File | 1993-03-13 | 16.0 KB | 471 lines

(* $Id: Parser.mi,v 2.8 1992/08/12 06:54:05 grosch rel $ *)

$@ IMPLEMENTATION MODULE @;

$@ IMPORT SYSTEM, $, Positions, Errors, Strings, DynArray, Sets, System;

$G    (* GLOBAL section is inserted here *)

CONST
   yyInitStackSize    = 100;
   yyNoState        = 0;

$T    (* Table Constants are inserted here *)

   yyFirstFinalState    = yyFirstReadTermState;
   yyLastState        = yyLastReduceState;

TYPE
   yyTableElmt        = SHORTCARD;
   yyTCombRange        = yyTableElmt [0 .. yyTableMax];
   yyNCombRange        = yyTableElmt [yyLastTerminal + 1 .. yyNTableMax];
   yyStateRange        = yyTableElmt [0 .. yyLastState];
   yyReadRange        = yyTableElmt [yyFirstReadState .. yyLastReadState];
   yyReadReduceRange    = yyTableElmt [yyFirstReadTermState ..yyLastReadNontermState];
   yyReduceRange    = yyTableElmt [yyFirstReduceState .. yyLastReduceState];
   yySymbolRange    = yyTableElmt [yyFirstSymbol .. yyLastSymbol];
   yyTCombType        = RECORD Check, Next: yyStateRange; END;
   yyNCombType        = yyStateRange;
   yyTCombTypePtr    = POINTER TO yyTCombType;
   yyNCombTypePtr    = POINTER TO yyNCombType;
   yyStackType        = POINTER TO ARRAY [0 .. 1000000] OF yyStateRange;

VAR
   yyTBasePtr        : ARRAY [0 .. yyLastReadState]    OF yyTCombTypePtr;
   yyNBasePtr        : ARRAY [0 .. yyLastReadState]    OF yyNCombTypePtr;
   yyDefault        : ARRAY [0 .. yyLastReadState]    OF yyReadRange    ;
   yyTComb        : ARRAY yyTCombRange        OF yyTCombType    ;
   yyNComb        : ARRAY yyNCombRange        OF yyNCombType    ;
   yyLength        : ARRAY yyReduceRange        OF yyTableElmt    ;
   yyLeftHandSide    : ARRAY yyReduceRange        OF yySymbolRange;
   yyContinuation    : ARRAY [0 .. yyLastReadState]    OF yySymbolRange;
   yyFinalToProd    : ARRAY yyReadReduceRange    OF yyReduceRange;
   yyIsInitialized    : BOOLEAN;
   yyTableFile        : System.tFile;

PROCEDURE TokenName (Token: CARDINAL; VAR Name: ARRAY OF CHAR);
   PROCEDURE Copy (Source: ARRAY OF CHAR; VAR Target: ARRAY OF CHAR);
      VAR i, j: CARDINAL;
      BEGIN
     IF HIGH (Source) < HIGH (Target)
     THEN j := HIGH (Source); ELSE j := HIGH (Target); END;
     FOR i := 0 TO j DO Target [i] := Source [i]; END;
     IF HIGH (Target) > j THEN Target [j + 1] := CHR (0); END;
      END Copy;
   BEGIN
      CASE Token OF
$W    (* token names are inserted here *)
      END;
   END TokenName;

$@ PROCEDURE @ (): CARDINAL;
$L    (* LOCAL section is inserted here *)
   VAR
      yyState        : yyStateRange;
      yyTerminal    : yySymbolRange;
      yyNonterminal    : yySymbolRange;    (* left-hand side symbol *)
      yyStackPtr    : yyTableElmt;
      yyStateStackSize    : LONGINT;
      yyAttrStackSize    : LONGINT;
      yyShortStackSize    : yyTableElmt;
      yyStateStack    : yyStackType;
      yyAttributeStack    : POINTER TO ARRAY [0 .. 1000000] OF tParsAttribute;
      yySynAttribute    : tParsAttribute;    (* synthesized attribute *)
$@       yyRepairAttribute : $.tScanAttribute;
      yyRepairToken    : yySymbolRange;
      yyTCombPtr    : yyTCombTypePtr;
      yyNCombPtr    : yyNCombTypePtr;
      yyIsRepairing    : BOOLEAN;
      yyErrorCount    : CARDINAL;
      yyTokenString    : ARRAY [0..127] OF CHAR;
   BEGIN
$@       Begin@;
      yyState        := yyStartState;
$@       yyTerminal    := $.GetToken ();
      yyStateStackSize    := yyInitStackSize;
      yyAttrStackSize    := yyInitStackSize;
      DynArray.MakeArray (yyStateStack, yyStateStackSize, SYSTEM.TSIZE (yyStateRange));
      DynArray.MakeArray (yyAttributeStack, yyAttrStackSize, SYSTEM.TSIZE (tParsAttribute));
      yyShortStackSize    := yyStateStackSize - 1;
      yyStackPtr    := 0;
      yyErrorCount    := 0;
      yyIsRepairing    := FALSE;

      LOOP
     IF yyStackPtr >= yyShortStackSize THEN
        DynArray.ExtendArray (yyStateStack, yyStateStackSize, SYSTEM.TSIZE (yyStateRange));
        DynArray.ExtendArray (yyAttributeStack, yyAttrStackSize, SYSTEM.TSIZE (tParsAttribute));
        yyShortStackSize := yyStateStackSize - 1;
     END;
     yyStateStack^ [yyStackPtr] := yyState;

     LOOP    (* SPEC State := Next (State, Terminal); terminal transition *)
        yyTCombPtr := yyTCombTypePtr (LONGCARD (yyTBasePtr [yyState])
                 + yyTerminal * SYSTEM.TSIZE (yyTCombType));
        IF yyTCombPtr^.Check = yyState THEN
           yyState := yyTCombPtr^.Next;
           EXIT;
        END;
        yyState := yyDefault [yyState];

        IF yyState = yyNoState THEN            (* syntax error *)
           yyState := yyStateStack^ [yyStackPtr];
           IF yyIsRepairing THEN            (* repair *)
          yyRepairToken := yyContinuation [yyState];
          yyState := Next (yyState, yyRepairToken);
          IF yyState <= yyLastReadTermState THEN (* read or read terminal reduce ? *)
$@              $.ErrorAttribute (yyRepairToken, yyRepairAttribute);
             TokenName (yyRepairToken, yyTokenString);
             Errors.ErrorMessageI (Errors.TokenInserted, Errors.Repair,
$@             $.Attribute.Position, Errors.Array, SYSTEM.ADR (yyTokenString));
             IF yyState >= yyFirstFinalState THEN (* avoid second push *)
            yyState := yyFinalToProd [yyState];
             END;
             INC (yyStackPtr);
             yyAttributeStack^ [yyStackPtr].Scan := yyRepairAttribute;
             yyStateStack^     [yyStackPtr] := yyState;
          END;
          IF yyState >= yyFirstFinalState THEN    (* final state ? *)
            EXIT;
          END;
           ELSE                    (* report and recover *)
          INC (yyErrorCount);
          ErrorRecovery (yyTerminal, yyStateStack, yyStateStackSize, yyStackPtr);
          yyIsRepairing := TRUE;
           END;
        END;
     END;

     IF yyState >= yyFirstFinalState THEN        (* final state ? *)
        IF yyState <= yyLastReadTermState THEN    (* read terminal reduce ? *)
           INC (yyStackPtr);
$@            yyAttributeStack^ [yyStackPtr].Scan := $.Attribute;
$@            yyTerminal := $.GetToken ();
           yyIsRepairing := FALSE;
$X           yyState := yyFinalToProd [yyState];
        END;

        LOOP                    (* reduce *)
$R    (* Code for Reductions is inserted here *)
           (* SPEC State := Next (Top (), Nonterminal); nonterminal transition *)
           yyNCombPtr := yyNCombTypePtr (LONGCARD (yyNBasePtr [yyStateStack^ [yyStackPtr]])
                + yyNonterminal * SYSTEM.TSIZE (yyNCombType));
           yyState := yyNCombPtr^;
           INC (yyStackPtr);
           yyAttributeStack^ [yyStackPtr] := yySynAttribute;
           IF yyState < yyFirstFinalState THEN EXIT END; (* read nonterminal ? *)
$X           yyState := yyFinalToProd [yyState];
        END;

     ELSE                        (* read *)
        INC (yyStackPtr);
$@         yyAttributeStack^ [yyStackPtr].Scan := $.Attribute;
$@         yyTerminal := $.GetToken ();
        yyIsRepairing := FALSE;
     END;
      END;
$@    END @;

PROCEDURE ErrorRecovery (
      VAR Terminal    : yySymbolRange    ;
      StateStack    : yyStackType    ;
      StackSize    : LONGINT    ;
      StackPtr    : LONGINT    );
   VAR
      TokensSkipped    : BOOLEAN;
      ContinueSet    : Sets.tSet;
      RestartSet    : Sets.tSet;
      Token        : yySymbolRange;
      TokenArray    : ARRAY [0..127] OF CHAR;
      TokenString    : Strings.tString;
      ContinueString    : Strings.tString;
   BEGIN
   (* 1. report the error *)
$@       Errors.ErrorMessage (Errors.SyntaxError, Errors.Error, $.Attribute.Position);

   (* 2. report the set of expected terminal symbols *)
      Sets.MakeSet (ContinueSet, yyLastTerminal);
      ComputeContinuation (StateStack, StackSize, StackPtr, ContinueSet);
      Strings.AssignEmpty (ContinueString);
      FOR Token := Sets.Minimum (ContinueSet) TO Sets.Maximum (ContinueSet) DO
     IF Sets.IsElement (Token, ContinueSet) THEN
        TokenName (Token, TokenArray);
        Strings.ArrayToString (TokenArray, TokenString);
        IF (Strings.Length (ContinueString) + Strings.Length (TokenString) + 1 <= Strings.cMaxStrLength) THEN
           Strings.Concatenate (ContinueString, TokenString);
           Strings.Append (ContinueString, ' ');
        END;
     END;
      END;
      Errors.ErrorMessageI (Errors.ExpectedTokens, Errors.Information,
$@      $.Attribute.Position, Errors.String, SYSTEM.ADR (ContinueString));
      Sets.ReleaseSet (ContinueSet);

   (* 3. compute the set of terminal symbols for restart of the parse *)
      Sets.MakeSet (RestartSet, yyLastTerminal);
      ComputeRestartPoints (StateStack, StackSize, StackPtr, RestartSet);

   (* 4. skip terminal symbols until a restart point is reached *)
      TokensSkipped := FALSE;
      WHILE NOT Sets.IsElement (Terminal, RestartSet) DO
$@      Terminal := $.GetToken ();
     TokensSkipped := TRUE;
      END;
      Sets.ReleaseSet (RestartSet);

   (* 5. report the restart point *)
      IF TokensSkipped THEN
$@      Errors.ErrorMessage (Errors.RestartPoint, Errors.Information, $.Attribute.Position);
      END;
   END ErrorRecovery;

(*
   compute the set of terminal symbols that can be accepted (read)
   in a given stack configuration (eventually after reduce actions)
*)

PROCEDURE ComputeContinuation (
      Stack        : yyStackType    ;
      StackSize    : LONGINT    ;
      StackPtr    : LONGINT    ;
      VAR ContinueSet    : Sets.tSet    );
   VAR Terminal        : yySymbolRange;
   BEGIN
      Sets.AssignEmpty (ContinueSet);
      FOR Terminal := yyFirstTerminal TO yyLastTerminal DO
     IF IsContinuation (Terminal, Stack, StackSize, StackPtr) THEN
        Sets.Include (ContinueSet, Terminal);
     END;
      END;
   END ComputeContinuation;

(*
   check whether a given terminal symbol can be accepted (read)
   in a certain stack configuration (eventually after reduce actions)
*)

PROCEDURE IsContinuation (
      Terminal        : yySymbolRange    ;
      ParseStack    : yyStackType    ;
      StackSize        : LONGINT    ;
      StackPtr        : LONGINT    ): BOOLEAN;
   VAR
      State        : LONGINT;
      Nonterminal    : yySymbolRange;
      Stack        : yyStackType;
   BEGIN
      DynArray.MakeArray (Stack, StackSize, SYSTEM.TSIZE (yyStateRange));
      FOR State := 0 TO StackPtr DO
     Stack^ [State] := ParseStack^ [State];
      END;
      State := Stack^ [StackPtr];
      LOOP
     Stack^ [StackPtr] := State;
     State := Next (State, Terminal);
     IF State = yyNoState THEN
        DynArray.ReleaseArray (Stack, StackSize, SYSTEM.TSIZE (yyStateRange));
        RETURN FALSE;
     END;
     IF State <= yyLastReadTermState THEN        (* read or read terminal reduce ? *)
        DynArray.ReleaseArray (Stack, StackSize, SYSTEM.TSIZE (yyStateRange));
        RETURN TRUE;
     END;

     LOOP                        (* reduce *)
        IF State =    yyStopState THEN
           DynArray.ReleaseArray (Stack, StackSize, SYSTEM.TSIZE (yyStateRange));
           RETURN TRUE;
        ELSE
           DEC (StackPtr, yyLength [State]);
           Nonterminal := yyLeftHandSide [State];
        END;

        State := Next (Stack^ [StackPtr], Nonterminal);
        IF StackPtr >= StackSize THEN
           DynArray.ExtendArray (Stack, StackSize, SYSTEM.TSIZE (yyStateRange));
        END;
        INC (StackPtr);
        IF State < yyFirstFinalState THEN EXIT; END; (* read nonterminal ? *)
        State := yyFinalToProd [State];        (* read nonterminal reduce *)
     END;
      END;
   END IsContinuation;

(*
   compute a set of terminal symbols that can be used to restart
   parsing in a given stack configuration. we simulate parsing until
   end of file using a suffix program synthesized by the function
   Continuation. All symbols acceptable in the states reached during
   the simulation can be used to restart parsing.
*)

PROCEDURE ComputeRestartPoints (
      ParseStack    : yyStackType    ;
      StackSize    : LONGINT    ;
      StackPtr    : LONGINT    ;
      VAR RestartSet    : Sets.tSet    );
   VAR
      Stack        : yyStackType;
      State        : LONGINT;
      Nonterminal    : yySymbolRange;
      ContinueSet    : Sets.tSet;
   BEGIN
      DynArray.MakeArray (Stack, StackSize, SYSTEM.TSIZE (yyStateRange));
      FOR State := 0 TO StackPtr DO
     Stack^ [State] := ParseStack^ [State];
      END;
      Sets.MakeSet (ContinueSet, yyLastTerminal);
      Sets.AssignEmpty (RestartSet);
      State := Stack^ [StackPtr];

      LOOP
     IF StackPtr >= StackSize THEN
        DynArray.ExtendArray (Stack, StackSize, SYSTEM.TSIZE (yyStateRange));
     END;
     Stack^ [StackPtr] := State;
     ComputeContinuation (Stack, StackSize, StackPtr, ContinueSet);
     Sets.Union (RestartSet, ContinueSet);
     State := Next (State, yyContinuation [State]);

     IF State >= yyFirstFinalState THEN        (* final state ? *)
        IF State <= yyLastReadTermState THEN    (* read terminal reduce ? *)
           INC (StackPtr);
           State := yyFinalToProd [State];
        END;

        LOOP                    (* reduce *)
           IF State = yyStopState THEN
          DynArray.ReleaseArray (Stack, StackSize, SYSTEM.TSIZE (yyStateRange));
          Sets.ReleaseSet (ContinueSet);
          RETURN;
           ELSE
          DEC (StackPtr, yyLength [State]);
          Nonterminal := yyLeftHandSide [State];
           END;

           State := Next (Stack^ [StackPtr], Nonterminal);
           INC (StackPtr);
           IF State < yyFirstFinalState THEN EXIT; END; (* read nonterminal ? *)
           State := yyFinalToProd [State];        (* read nonterminal reduce *)
        END;
     ELSE                        (* read *)
        INC (StackPtr);
     END;
      END;
   END ComputeRestartPoints;

(* access the parse table:   Next : State x Symbol -> State *)

PROCEDURE Next (State: yyStateRange; Symbol: yySymbolRange): yyStateRange;
   VAR
      TCombPtr        : yyTCombTypePtr;
      NCombPtr        : yyNCombTypePtr;
   BEGIN
      IF Symbol <= yyLastTerminal THEN
     LOOP
        TCombPtr := yyTCombTypePtr (LONGCARD (yyTBasePtr [State])
               + Symbol * SYSTEM.TSIZE (yyTCombType));
        IF TCombPtr^.Check # State THEN
           State := yyDefault [State];
           IF State = yyNoState THEN RETURN yyNoState; END;
        ELSE
           RETURN TCombPtr^.Next;
        END;
     END;
      ELSE
    NCombPtr := yyNCombTypePtr (LONGCARD (yyNBasePtr [State])
            + Symbol * SYSTEM.TSIZE (yyNCombType));
    RETURN NCombPtr^;
      END;
   END Next;

PROCEDURE yyGetTables;
   VAR
      BlockSize, j, n    : CARDINAL;
      State    : yyStateRange;
      TBase    : ARRAY [0 .. yyLastReadState] OF yyTCombRange;
      NBase    : ARRAY [0 .. yyLastReadState] OF yyNCombRange;
   BEGIN
      BlockSize    := 64000 DIV SYSTEM.TSIZE (yyTCombType);
      yyTableFile := System.OpenInput (ParsTabName);
      yyErrorCheck (Errors.OpenParseTable, yyTableFile);
      IF
     (yyGetTable (SYSTEM.ADR (TBase            )) DIV SYSTEM.TSIZE (yyTCombRange ) - 1
        # yyLastReadState) OR
     (yyGetTable (SYSTEM.ADR (NBase            )) DIV SYSTEM.TSIZE (yyNCombRange ) - 1
        # yyLastReadState) OR
     (yyGetTable (SYSTEM.ADR (yyDefault     )) DIV SYSTEM.TSIZE (yyReadRange  ) - 1
        # yyLastReadState) OR
     (yyGetTable (SYSTEM.ADR (yyNComb       )) DIV SYSTEM.TSIZE (yyNCombType  )
        # yyNTableMax - yyLastTerminal) OR
     (yyGetTable (SYSTEM.ADR (yyLength      )) DIV SYSTEM.TSIZE (yyTableElmt  ) - 1
        # yyLastReduceState - yyFirstReduceState) OR
     (yyGetTable (SYSTEM.ADR (yyLeftHandSide)) DIV SYSTEM.TSIZE (yySymbolRange) - 1
        # yyLastReduceState - yyFirstReduceState) OR
     (yyGetTable (SYSTEM.ADR (yyContinuation)) DIV SYSTEM.TSIZE (yySymbolRange) - 1
        # yyLastReadState) OR
     (yyGetTable (SYSTEM.ADR (yyFinalToProd )) DIV SYSTEM.TSIZE (yyReduceRange) - 1
        # yyLastReadNontermState - yyFirstReadTermState)
      THEN
     Errors.ErrorMessage (Errors.WrongParseTable, Errors.Fatal, Positions.NoPosition);
      END;
      n := 0;
      j := 0;
      WHILE j <= yyTableMax DO
     INC (n, yyGetTable (SYSTEM.ADR (yyTComb [j])) DIV SYSTEM.TSIZE (yyTCombType));
         INC (j, BlockSize);
      END;
      IF n # yyTableMax + 1 THEN
     Errors.ErrorMessage (Errors.WrongParseTable, Errors.Fatal, Positions.NoPosition);
      END;
      System.Close (yyTableFile);

      FOR State := 1 TO yyLastReadState DO
     yyTBasePtr [State] := SYSTEM.ADR (yyTComb [TBase [State]]);
      END;
      FOR State := 1 TO yyLastReadState DO
     yyNBasePtr [State] := SYSTEM.ADR (yyNComb [NBase [State]]);
      END;
   END yyGetTables;

PROCEDURE yyGetTable (Address: SYSTEM.ADDRESS): CARDINAL;
   VAR
      N        : INTEGER;
      Length    : yyTableElmt;
   BEGIN
      N := System.Read (yyTableFile, SYSTEM.ADR (Length), SYSTEM.TSIZE (yyTableElmt));
      yyErrorCheck (Errors.ReadParseTable, N);
      N := System.Read (yyTableFile, Address, Length);
      yyErrorCheck (Errors.ReadParseTable, N);
      RETURN Length;
   END yyGetTable;

PROCEDURE yyErrorCheck (ErrorCode: INTEGER; Info: INTEGER);
   VAR ErrNo: INTEGER;
   BEGIN
     IF Info < 0 THEN
    ErrNo := System.ErrNum ();
    Errors.ErrorMessageI (ErrorCode, Errors.Fatal, Positions.NoPosition,
       Errors.Integer, SYSTEM.ADR (ErrNo));
     END;
   END yyErrorCheck;

$@ PROCEDURE Begin@;
   BEGIN
$B    (* BEGIN section is inserted here *)
      IF NOT yyIsInitialized THEN
     yyIsInitialized := TRUE;
     yyGetTables;
      END;
$@    END Begin@;

$@ PROCEDURE Close@;
   BEGIN
$C    (* CLOSE section is inserted here *)
$@    END Close@;

BEGIN
    yyIsInitialized := FALSE;
$@     ParsTabName := '@.Tab';
$@ END @.